home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Oberon⁄F™ 1.1 / Obx / Mod / Orders0 (.txt) < prev    next >
Encoding:
Oberon Document  |  1996-01-05  |  9.8 KB  |  273 lines  |  [oODC/obnF]
  1. Documents.StdDocumentDesc
  2. Documents.DocumentDesc
  3. Containers.ViewDesc
  4. Views.ViewDesc
  5. Stores.StoreDesc
  6. Documents.ModelDesc
  7. Containers.ModelDesc
  8. Models.ModelDesc
  9. Stores.ElemDesc
  10. TextViews.StdViewDesc
  11. TextViews.ViewDesc
  12. TextModels.StdModelDesc
  13. TextModels.ModelDesc
  14. TextModels.AttributesDesc
  15. Helvetica
  16. Helvetica
  17. Helvetica
  18. MODULE ObxOrders0;
  19.     IMPORT
  20.         Files, Dialog, Fonts, Ports, Stores, Views, Properties,
  21.         TextModels, TextViews, TextMappers, TextRulers, StdCmds, StdStamps;
  22.     CONST
  23.         (* values for card field of interactor *)
  24.         amex = 0; master = 1; visa = 2;
  25.         (* prices in 1/100 Swiss Francs *)
  26.         ofwinfullVal = 45000; ofmacfullVal = 45000; ofwineduVal = LONG(15000); ofmaceduVal = LONG(15000);
  27.         odfVal = LONG(5000); vatVal = 65;
  28.         type = "DATA";    (* file type *)
  29.     TYPE
  30.         Interactor* = RECORD (Dialog.Interactor)
  31.             name*, company*, adr1*, adr2*, adr3*, email*: ARRAY 128 OF CHAR;
  32.             phone*, fax*: ARRAY 32 OF CHAR;
  33.             ofwinfull*, ofmacfull*, ofwinedu*, ofmacedu*, odf*: INTEGER;
  34.             card*: INTEGER;
  35.             cardno*: ARRAY 24 OF CHAR;
  36.             vat*: BOOLEAN
  37.         END;
  38.         Element = POINTER TO ElementDesc;
  39.         ElementDesc = RECORD
  40.             prev, next: Element;
  41.             data: Interactor
  42.         END;
  43.         par*: Interactor;
  44.         root, cur: Element;    (* header and current element of doubly-linked ring *)
  45.         name: Files.Name;
  46.         loc: Files.Locator;
  47.     PROCEDURE ReadElem (VAR rd: Stores.Reader; VAR e: ElementDesc);
  48.     BEGIN
  49.         rd.ReadString(e.data.name); rd.ReadString(e.data.company);
  50.         rd.ReadString(e.data.adr1); rd.ReadString(e.data.adr2); rd.ReadString(e.data.adr3);
  51.         rd.ReadString(e.data.email);
  52.         rd.ReadString(e.data.phone); rd.ReadString(e.data.fax);
  53.         rd.ReadString(e.data.cardno);
  54.         rd.ReadInt(e.data.ofwinfull); rd.ReadInt(e.data.ofmacfull);
  55.         rd.ReadInt(e.data.ofwinedu); rd.ReadInt(e.data.ofmacedu);
  56.         rd.ReadInt(e.data.odf);
  57.         rd.ReadInt(e.data.card);
  58.         rd.ReadBool(e.data.vat)
  59.     END ReadElem;
  60.     PROCEDURE WriteElem (VAR wr: Stores.Writer; VAR e: ElementDesc);
  61.     BEGIN
  62.         wr.WriteString(e.data.name); wr.WriteString(e.data.company);
  63.         wr.WriteString(e.data.adr1); wr.WriteString(e.data.adr2); wr.WriteString(e.data.adr3);
  64.         wr.WriteString(e.data.email);
  65.         wr.WriteString(e.data.phone); wr.WriteString(e.data.fax);
  66.         wr.WriteString(e.data.cardno);
  67.         wr.WriteInt(e.data.ofwinfull); wr.WriteInt(e.data.ofmacfull);
  68.         wr.WriteInt(e.data.ofwinedu); wr.WriteInt(e.data.ofmacedu);
  69.         wr.WriteInt(e.data.odf);
  70.         wr.WriteInt(e.data.card);
  71.         wr.WriteBool(e.data.vat)
  72.     END WriteElem;
  73.     PROCEDURE Init;
  74.     BEGIN
  75.         cur := root; root.next := root; root.prev := root
  76.     END Init;
  77.     PROCEDURE Update;
  78.     BEGIN
  79.         par := cur.data; Dialog.Update(par); Dialog.CheckGuards
  80.     END Update;
  81.     PROCEDURE Load*;
  82.         VAR e: Element; f: Files.File; rd: Stores.Reader; count: LONGINT;
  83.     BEGIN
  84.         Dialog.GetIntSpec(type, loc, name);
  85.         IF loc # NIL THEN
  86.             f := Files.dir.Old(loc, name, Files.shared);
  87.             IF (f # NIL) & (f.type = type) THEN
  88.                 rd.ConnectTo(f);
  89.                 rd.ReadLInt(count);
  90.                 Init;
  91.                 WHILE count # 0 DO
  92.                     NEW(e);
  93.                     IF e # NIL THEN
  94.                         e.prev := cur; e.next := cur.next; e.prev.next := e; e.next.prev := e;
  95.                         ReadElem(rd, e^);
  96.                         cur := e; DEC(count)
  97.                     ELSE
  98.                         Dialog.ShowMsg("out of memory"); Dialog.Beep;
  99.                         count := 0; root.next := root; root.prev := root; cur := root
  100.                     END
  101.                 END;
  102.                 Update
  103.             ELSE
  104.                 Dialog.ShowMsg("cannot open file"); Dialog.Beep
  105.             END
  106.         END
  107.     END Load;
  108.     PROCEDURE Save*;
  109.         VAR e: Element; f: Files.File; wr: Stores.Writer; count, res: LONGINT;
  110.     BEGIN
  111.         IF (loc = NIL) OR (name = "") THEN Dialog.GetExtSpec("", "", loc, name) END;
  112.         IF (loc # NIL) & (name # "") THEN
  113.             f := Files.dir.New(loc); wr.ConnectTo(f);
  114.             e := root.next; count := 0; WHILE e # root DO INC(count); e := e.next END;    (* count elements *)
  115.             wr.WriteLInt(count);
  116.             e := root.next; WHILE e # root DO WriteElem(wr, e^); e := e.next END;    (* write elements *)
  117.             f.Register(name, type, res);
  118.             Init; name := ""; loc := NIL;    (* close database *)
  119.             Update
  120.         END
  121.     END Save;
  122.     PROCEDURE Insert*;
  123.         VAR e: Element;
  124.     BEGIN
  125.         NEW(e);
  126.         IF e # NIL THEN    (* insert new record at end of database *)
  127.             IF cur # root THEN cur.data := par END;    (* save current record, in case it was changed *)
  128.             e.prev := root.prev; e.next := root; e.prev.next := e; e.next.prev := e;
  129.             cur := e;
  130.             Update
  131.         ELSE
  132.             Dialog.ShowMsg("out of memory"); Dialog.Beep
  133.         END
  134.     END Insert;
  135.     PROCEDURE Delete*;
  136.     BEGIN
  137.         IF cur # root THEN
  138.             StdCmds.CloseDialog;
  139.             cur.next.prev := cur.prev; cur.prev.next := cur.next;
  140.             cur := cur.prev; IF cur = root THEN cur := root.next END;
  141.             Update
  142.         END
  143.     END Delete;
  144.     PROCEDURE Next*;
  145.     BEGIN
  146.         IF cur.next # root THEN
  147.             cur.data := par; cur := cur.next; Update
  148.         END
  149.     END Next;
  150.     PROCEDURE Prev*;
  151.     BEGIN
  152.         IF cur.prev # root THEN
  153.             cur.data := par; cur := cur.prev; Update
  154.         END
  155.     END Prev;
  156.     PROCEDURE NonemptyGuard* (VAR par: Dialog.Par);
  157.     BEGIN
  158.         IF cur = root THEN par.disabled := TRUE END
  159.     END NonemptyGuard;
  160.     PROCEDURE NextGuard* (VAR par: Dialog.Par);
  161.     BEGIN
  162.         IF cur.next = root THEN par.disabled := TRUE END
  163.     END NextGuard;
  164.     PROCEDURE PrevGuard* (VAR par: Dialog.Par);
  165.     BEGIN
  166.         IF cur.prev = root THEN par.disabled := TRUE END
  167.     END PrevGuard;
  168.     PROCEDURE WriteLine (VAR f: TextMappers.Formatter; no, val: LONGINT; name: ARRAY OF CHAR;
  169.                                         VAR total, vat: LONGINT);
  170.     BEGIN
  171.         IF no # 0 THEN
  172.             val := no * val;
  173.             f.WriteInt(no); f.WriteString(name);
  174.             INC(total, val); INC(vat, val);
  175.             f. WriteTab;
  176.             f.WriteIntForm(val DIV 100, 10, 5, TextModels.digitspace, FALSE);
  177.             f.WriteChar(".");
  178.             f.WriteIntForm(val MOD 100, 10, 2, "0", FALSE);
  179.             f.WriteLn
  180.         END
  181.     END WriteLine;
  182.     PROCEDURE NewRuler (): TextRulers.Ruler;
  183.         VAR p: TextRulers.Prop;
  184.     BEGIN
  185.         NEW(p);
  186.         p.left.val := 30 * Ports.mm;
  187.         p.right.val := 165 * Ports.mm;
  188.         p.tabs.len := 1; p.tabs.tab[0].val := 130 * Ports.mm;
  189.         p.valid := {TextRulers.left, TextRulers.right, TextRulers.tabs};
  190.         RETURN TextRulers.dir.NewFromProp(p)
  191.     END NewRuler;
  192.     PROCEDURE Invoice*;
  193.         VAR v: TextViews.View; f: TextMappers.Formatter; a: TextModels.Attributes;
  194.             total, vat, val: LONGINT;
  195.     BEGIN
  196.         IF cur # root THEN
  197.             v := TextViews.dir.New(TextModels.dir.New());
  198.             f.ConnectTo(v.ThisModel());
  199.             f.WriteView(NewRuler());
  200.             (* create header of invoice *)
  201.             f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn;
  202.             f.WriteTab;
  203.             f.WriteString("Basel, "); f.WriteView(StdStamps.New(StdStamps.dmy));
  204.             f.WriteLn; f.WriteLn; f.WriteLn;
  205.             (* write address *)
  206.             IF par.name # "" THEN f.WriteString(par.name); f.WriteLn END;
  207.             IF par.company # "" THEN f.WriteString(par.company); f.WriteLn END;
  208.             IF par.adr1 # "" THEN f.WriteString(par.adr1); f.WriteLn END;
  209.             IF par.adr2 # "" THEN f.WriteString(par.adr2); f.WriteLn END;
  210.             IF par.adr3 # "" THEN f.WriteString(par.adr3); f.WriteLn END;
  211.             f.WriteLn; f.WriteLn; f.WriteLn;
  212.             (* set bold font weight *)
  213.             a := f.rider.attr;
  214.             f.rider.SetAttr(TextModels.NewWeight(a, Fonts.bold));
  215.             f.WriteString("Invoice");    (* this string will appear in bold face *)
  216.             f.rider.SetAttr(a);    (* restore default weight *)
  217.             f.WriteLn; f.WriteLn;
  218.             f.WriteString("Creditcard: ");
  219.             CASE par.card OF
  220.             | amex: f.WriteString("American Express")
  221.             | master: f.WriteString("Euro/MasterCard")
  222.             | visa: f.WriteString("Visa")
  223.             END;
  224.             f.WriteLn; f.WriteLn; f.WriteLn;
  225.             (* write products with subtotals *)
  226.             total := 0; vat := 0;
  227.             WriteLine(f, par.ofwinfull, ofwinfullVal, " ofwin full", total, vat);
  228.             WriteLine(f, par.ofmacfull, ofmacfullVal, " ofmac full", total, vat);
  229.             WriteLine(f, par.ofwinedu, ofwineduVal, " ofwin edu", total, vat);
  230.             WriteLine(f, par.ofmacedu, ofmaceduVal, " ofmac edu", total, vat);
  231.             WriteLine(f, par.odf, odfVal, " odf", total, vat);
  232.             (* write vat *)
  233.             IF par.vat THEN
  234.                 f.WriteLn;
  235.                 INC(total, (vat * vatVal) DIV 1000);    (* vat is 6.5% *)
  236.                 f.WriteString("value added tax (");
  237.                 f.WriteInt(vatVal DIV 10); f.WriteChar("."); f.WriteInt(vatVal MOD 10);
  238.                 f.WriteString("% on ");
  239.                 f.WriteInt(vat DIV 100); f.WriteChar("."); f.WriteIntForm(vat MOD 100, 10, 2, "0", FALSE);
  240.                 f.WriteString(")");
  241.                 f.WriteTab;
  242.                 f.WriteIntForm((vat * vatVal) DIV 100000, 10, 5, TextModels.digitspace, FALSE);
  243.                 f.WriteChar("."); f.WriteIntForm(((vat * vatVal) DIV 1000) MOD 100, 10, 2, "0", FALSE);
  244.                 f.WriteLn
  245.             END;
  246.             (* write total *)
  247.             f.WriteLn;
  248.             f.WriteString("Total"); f.WriteTab;
  249.             f.WriteIntForm(total DIV 100, 10, 5, TextModels.digitspace, FALSE);
  250.             f.WriteChar("."); f.WriteIntForm(total MOD 100, 10, 2, "0", FALSE);
  251.             f.WriteString(" sFr.");
  252.             f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn;
  253.             f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn;
  254.             f.WriteString("The exporter of the products covered by this document declares that, except where otherwise clearly indicated, these products are of Swiss preferential origin.");
  255.             f.WriteLn;
  256.             Views.OpenAux(v, "Invoice")
  257.         END
  258.     END Invoice;
  259. BEGIN
  260.     NEW(root); Init
  261. END ObxOrders0.
  262. TextControllers.StdCtrlDesc
  263. TextControllers.ControllerDesc
  264. Containers.ControllerDesc
  265. Controllers.ControllerDesc
  266. TextRulers.StdRulerDesc
  267. TextRulers.RulerDesc
  268. TextRulers.StdStyleDesc
  269. TextRulers.StyleDesc
  270. TextRulers.AttributesDesc
  271. Helvetica
  272. Documents.ControllerDesc
  273.